unit uGHWViewMain ;

interface

uses
  Windows,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Messages,
  Variants,
  Dialogs,
  ImgList,
  ActnList,
  StdActns,
  Menus,
  StdCtrls,
  ComCtrls,
  Inifiles,
  SHChangeNotify,
  // VirtualTrees,
  uGHWVTSim,
  uGHWReader,
  PJWdwState,
  fmAbout,
  ExtCtrls,
  ToolWin,
  PlatformDefaultStyleActnCtrls,
  ActnMan,
  ActnCtrls,
  ActnMenus,
  RibbonObsidianStyleActnCtrls,
  RibbonLunaStyleActnCtrls ;

type
  TFormHelper = class( TThread )
  private
    fFilename : string ;
    procedure SetFilename( const Value : string ) ;
    procedure PutSimulation ;
    procedure ClearSimulation ;
  public
    property Filename : string read fFilename write SetFilename ;
    procedure Execute ; override ;
  end ;

  TfrmMain = class( TForm )
    ActionManager : TActionManager ;
    ActionToolBar : TActionToolBar ;
    ImageList : TImageList ;
    actNew : TAction ;
    actMRU : TAction ;
    actFileOpen : TFileOpen ;
    actFileSaveAs : TFileSaveAs ;
    actFileExit : TFileExit ;
    actSave : TAction ;
    actZoomIn : TAction ;
    actZoomOut : TAction ;
    actStart : TAction ;
    actEnd : TAction ;
    actRight : TAction ;
    actLeft : TAction ;
    actPlus : TAction ;
    actMinus : TAction ;
    actAbout : TAction ;
    actZoomAll : TAction ;
    actShowAll : TAction ;
    actHideSelected : TAction ;
    actHideProcess : TAction ;
    actHidePackage : TAction ;
    actHideInstance : TAction ;
    StatusBar1 : TStatusBar ;
    actElab : TAction ;
    pgMain : TPageControl ;
    tsSim : TTabSheet ;
    TabSheet2 : TTabSheet ;
    TabSheet3 : TTabSheet ;
    lvNames : TListView ;
    lvTypes : TListView ;

    procedure FormCreate( Sender : TObject ) ;
    procedure FormDestroy( Sender : TObject ) ;
    procedure actFileOpenBeforeExecute( Sender : TObject ) ;
    procedure actFileOpenAccept( Sender : TObject ) ;
    procedure actNewExecute( Sender : TObject ) ;
    procedure miMRUClick( Sender : TObject ) ;
    procedure actZoomInExecute( Sender : TObject ) ;
    procedure actZoomInUpdate( Sender : TObject ) ;
    procedure actZoomOutExecute( Sender : TObject ) ;
    procedure actZoomOutUpdate( Sender : TObject ) ;
    procedure actStartExecute( Sender : TObject ) ;
    procedure actEndExecute( Sender : TObject ) ;
    procedure actEndUpdate( Sender : TObject ) ;
    procedure actStartUpdate( Sender : TObject ) ;
    procedure actRightExecute( Sender : TObject ) ;
    procedure actRightUpdate( Sender : TObject ) ;
    procedure actLeftExecute( Sender : TObject ) ;
    procedure actLeftUpdate( Sender : TObject ) ;
    procedure actPlusExecute( Sender : TObject ) ;
    procedure actMinusExecute( Sender : TObject ) ;
    procedure actMinusUpdate( Sender : TObject ) ;
    procedure actPlusUpdate( Sender : TObject ) ;
    procedure actAboutExecute( Sender : TObject ) ;

    procedure actNewUpdate( Sender : TObject ) ;
    procedure actFileOpenUpdate( Sender : TObject ) ;
    procedure actFileSaveAsUpdate( Sender : TObject ) ;
    procedure actSaveExecute( Sender : TObject ) ;
    procedure actSaveUpdate( Sender : TObject ) ;
    procedure actFileExitUpdate( Sender : TObject ) ;
    procedure actZoomAllExecute( Sender : TObject ) ;
    procedure actShowAllExecute( Sender : TObject ) ;
    procedure actHideSelectedExecute( Sender : TObject ) ;
    procedure actShowAllUpdate( Sender : TObject ) ;
    procedure actHideSelectedUpdate( Sender : TObject ) ;
    procedure actZoomAllUpdate( Sender : TObject ) ;
    procedure actHideProcessExecute( Sender : TObject ) ;
    procedure actHideProcessUpdate( Sender : TObject ) ;
    procedure actHidePackageExecute( Sender : TObject ) ;
    procedure actHidePackageUpdate( Sender : TObject ) ;
    procedure actHideInstanceExecute( Sender : TObject ) ;
    procedure actHideInstanceUpdate( Sender : TObject ) ;
    procedure actElabExecute( Sender : TObject ) ;
    procedure actElabUpdate( Sender : TObject ) ;
    procedure actFileSaveAsBeforeExecute( Sender : TObject ) ;
    procedure actFileSaveAsSaveDialogClose( Sender : TObject ) ;
    procedure actFileSaveAsAccept( Sender : TObject ) ;
  private
    fVTSim : TGHWVTsim ;
    fHelper : TFormHelper ;
    fShChNot : TSHChangeNotify ;
    fState : TPJWdwState ;
    fIniname : string ;

    procedure Elaborate( aFilename : TFilename ) ;
    procedure DoUpdateItem( Sender : TObject ; Flags : cardinal ; Path1 : string ) ;
    procedure ReadIniSettings ;
    procedure WriteIniSettings ;
    procedure ShowTypes ;
    procedure ShowNames ;
  public
  end ;

  EMyAssert = class( Exception ) ;
procedure AssertErrorHandler( const message, Filename : string ; LineNumber : integer ; ErrorAddr : Pointer ) ;

var
  frmMain : TfrmMain ;

implementation

{$R *.dfm}

uses
  IOUtils,
  PJVersionInfo ;

//
{$ASSERTIONS ON}

procedure DoMessage( message, Filename : string ; LineNumber : integer ; ErrorAddr : Pointer ) ;
var
  S : string ;
begin
  S := Format( '%s (%s, line %d, address $%x)', [ message, Filename, LineNumber, Pred( integer( ErrorAddr ) ) ] ) ;
  OutputDebugString( PChar( S ) ) ;
  raise EMyAssert.Create( S ) ;
end ;

procedure AssertErrorHandler( const message, Filename : string ; LineNumber : integer ; ErrorAddr : Pointer ) ;
begin
  DoMessage( message, Filename, LineNumber, ErrorAddr ) ;
end ;

procedure AssertErrorNoHandler( const message, Filename : string ; LineNumber : integer ; ErrorAddr : Pointer ) ;
begin
end ;

procedure TfrmMain.actNewExecute( Sender : TObject ) ;
begin
  fHelper.ClearSimulation ;
end ;

procedure TfrmMain.actNewUpdate( Sender : TObject ) ;
begin
  ( Sender as TAction ).Enabled := fHelper.Suspended ;
end ;

procedure TfrmMain.actEndExecute( Sender : TObject ) ;
begin
  fVTSim.ToEnd ;
end ;

procedure TfrmMain.actStartExecute( Sender : TObject ) ;
begin
  fVTSim.ToBegin ;
end ;

procedure TfrmMain.actStartUpdate( Sender : TObject ) ;
begin
  actStart.Enabled := assigned( fVTSim.HieRoot ) ;
end ;

procedure TfrmMain.actEndUpdate( Sender : TObject ) ;
begin
  actEnd.Enabled := assigned( fVTSim.HieRoot ) ;
end ;

procedure TfrmMain.actPlusExecute( Sender : TObject ) ;
begin
  fVTSim.Plus ;
end ;

procedure TfrmMain.actPlusUpdate( Sender : TObject ) ;
begin
  actPlus.Enabled := assigned( fVTSim.HieRoot ) ;
end ;

procedure TfrmMain.actLeftExecute( Sender : TObject ) ;
begin
  fVTSim.ToLeft ;
end ;

procedure TfrmMain.actLeftUpdate( Sender : TObject ) ;
begin
  actLeft.Enabled := assigned( fVTSim.HieRoot ) ;
end ;

procedure TfrmMain.actMinusExecute( Sender : TObject ) ;
begin
  fVTSim.Minus ;
end ;

procedure TfrmMain.actMinusUpdate( Sender : TObject ) ;
begin
  actMinus.Enabled := assigned( fVTSim.HieRoot ) ;
end ;

procedure TfrmMain.actRightExecute( Sender : TObject ) ;
begin
  fVTSim.ToRight ;
end ;

procedure TfrmMain.actRightUpdate( Sender : TObject ) ;
begin
  actRight.Enabled := assigned( fVTSim.HieRoot ) ;
end ;

procedure TfrmMain.actZoomAllExecute( Sender : TObject ) ;
begin
  fVTSim.ZoomAll ;
end ;

procedure TfrmMain.actZoomAllUpdate( Sender : TObject ) ;
begin
  actZoomAll.Enabled := fVTSim.ZoomEnabled ;
end ;

procedure TfrmMain.actZoomInExecute( Sender : TObject ) ;
begin
  fVTSim.ZoomIn ;
end ;

procedure TfrmMain.actZoomInUpdate( Sender : TObject ) ;
begin
  actZoomIn.Enabled := fVTSim.ZoomEnabled and ( fVTSim.Zoom < 16 ) ;
end ;

procedure TfrmMain.actZoomOutExecute( Sender : TObject ) ;
begin
  fVTSim.ZoomOut ;
end ;

procedure TfrmMain.actZoomOutUpdate( Sender : TObject ) ;
begin
  actZoomOut.Enabled := fVTSim.ZoomEnabled and ( fVTSim.Zoom > 1 ) ;
end ;

procedure TfrmMain.ShowTypes ;
var
  i : integer ;
  iItem : TListItem ;
begin
  with gReader do
    for i := 0 to NbrTypes - 1 do begin
      iItem := lvTypes.Items.Add ;
      iItem.Caption := IntToStr( i ) ;
      iItem.SubItems.Add( KindToString( Types[ i ].Kind ) ) ;
      iItem.SubItems.Add( Types[ i ].name ) ;
      iItem.SubItems.Add( Types[ i ].ClassName ) ;
      iItem.SubItems.Add( Types[ i ].DisplayName ) ;
      if assigned( Types[ i ].BaseType ) and ( Types[ i ].BaseType <> Types[ i ] ) then begin
        iItem.SubItems.Add( KindToString( Types[ i ].BaseType.Kind ) ) ;
        iItem.SubItems.Add( Types[ i ].BaseType.name ) ;
        iItem.SubItems.Add( Types[ i ].BaseType.ClassName ) ;
        iItem.SubItems.Add( Types[ i ].BaseType.DisplayName ) ;
      end
      else
        iItem.SubItems.Add( '<>' ) ;
    end ;
end ;

procedure TfrmMain.ShowNames ;
var
  i : integer ;
  iItem : TListItem ;
begin
  with gReader do
    for i := 0 to NbrStrings - 1 do begin
      iItem := lvNames.Items.Add ;
      iItem.Caption := IntToStr( i ) ;
      iItem.SubItems.Add( Strings[ i ] )
    end ;
end ;

procedure TfrmMain.Elaborate( aFilename : TFilename ) ;
begin
  if fHelper.Suspended then
    fHelper.Filename := aFilename ;
end ;

procedure TfrmMain.miMRUClick( Sender : TObject ) ;
begin
  if fHelper.Suspended then
    Elaborate( ( Sender as TMenuItem ).Caption ) ;
end ;

procedure TfrmMain.actAboutExecute( Sender : TObject ) ;
begin
  with TdlgAbout.Create( Self ) do
    try
      ShowModal ;
    finally
      Free ;
    end ;
end ;

procedure TfrmMain.actFileExitUpdate( Sender : TObject ) ;
begin
  actFileExit.Enabled := fHelper.Suspended ;
end ;

procedure TfrmMain.actFileOpenAccept( Sender : TObject ) ;
var
  S : string ;
begin
  fHelper.ClearSimulation ;
  S := actFileOpen.Dialog.Filename ;
  fVTSim.LoadFromFile( ChangeFileExt( S, '.vts' ) ) ;
  Elaborate( S ) ;
end ;

procedure TfrmMain.actFileOpenBeforeExecute( Sender : TObject ) ;
begin
  //
end ;

procedure TfrmMain.actFileOpenUpdate( Sender : TObject ) ;
begin
  actFileOpen.Enabled := fHelper.Suspended ;
end ;

procedure TfrmMain.actSaveExecute( Sender : TObject ) ;
begin
  //
end ;

procedure TfrmMain.actSaveUpdate( Sender : TObject ) ;
begin
  actSave.Enabled := fHelper.Suspended ;
end ;

procedure TfrmMain.actFileSaveAsAccept( Sender : TObject ) ;
begin
  fVTSim.SaveToFile( actFileSaveAs.Dialog.Filename ) ;
end ;

procedure TfrmMain.actFileSaveAsBeforeExecute( Sender : TObject ) ;
var
  S : string ;
begin
  S := actFileOpen.Dialog.Filename ;
  actFileSaveAs.Dialog.Filename := ChangeFileExt( S, '.vts' ) ;
end ;

procedure TfrmMain.actFileSaveAsSaveDialogClose( Sender : TObject ) ;
begin
  // fVTSim.SaveToFile( actFileSaveAs.Dialog.Filename ) ;
end ;

procedure TfrmMain.actFileSaveAsUpdate( Sender : TObject ) ;
begin
  actFileSaveAs.Enabled := fHelper.Suspended ;
end ;

procedure TfrmMain.actShowAllExecute( Sender : TObject ) ;
begin
  fVTSim.ShowAll ;
end ;

procedure TfrmMain.actShowAllUpdate( Sender : TObject ) ;
begin
  actShowAll.Enabled := assigned( fVTSim.HieRoot ) ;
end ;

procedure TfrmMain.actHideSelectedExecute( Sender : TObject ) ;
begin
  fVTSim.HideSelected ;
end ;

procedure TfrmMain.actHideSelectedUpdate( Sender : TObject ) ;
begin
  actHideSelected.Enabled := assigned( fVTSim.HieRoot ) ;
end ;

procedure TfrmMain.actElabExecute( Sender : TObject ) ;
begin
  if fHelper.Suspended then begin
    fHelper.ClearSimulation ;
    fHelper.Resume ;
  end ;
end ;

procedure TfrmMain.actElabUpdate( Sender : TObject ) ;
begin
  ( Sender as TAction ).Enabled := fHelper.Suspended ;
end ;

procedure TfrmMain.actHideInstanceExecute( Sender : TObject ) ;
begin
  fVTSim.HideInstances ;
end ;

procedure TfrmMain.actHideInstanceUpdate( Sender : TObject ) ;
begin
  actHideInstance.Enabled := assigned( fVTSim.HieRoot ) ;
end ;

procedure TfrmMain.actHidePackageExecute( Sender : TObject ) ;
begin
  fVTSim.HidePackages ;
end ;

procedure TfrmMain.actHidePackageUpdate( Sender : TObject ) ;
begin
  actHidePackage.Enabled := assigned( fVTSim.HieRoot ) ;
end ;

procedure TfrmMain.actHideProcessExecute( Sender : TObject ) ;
begin
  fVTSim.HideProcesses ;
end ;

procedure TfrmMain.actHideProcessUpdate( Sender : TObject ) ;
begin
  actHideProcess.Enabled := assigned( fVTSim.HieRoot ) ;
end ;

procedure TfrmMain.DoUpdateItem( Sender : TObject ; Flags : cardinal ; Path1 : string ) ;
var
  S : string ;
begin
  S := TPath.GetExtension( Path1 ) ;

  if S = '.ghw' then begin
    Elaborate( Path1 ) ;
    SetForegroundWindow( handle ) ;
  end ;
end ;

procedure TfrmMain.FormCreate( Sender : TObject ) ;
begin
  fHelper := TFormHelper.Create( true ) ;

  fIniname := ChangeFileExt( Application.ExeName, '.ini' ) ;
  fState := TPJWdwState.CreateStandAlone( Self ) ;
  fState.IniFileName := fIniname ;
  fState.Section := 'Main' ;
  fState.AutoSaveRestore := true ;

  fVTSim := TGHWVTsim.Create( Self ) ;
  fVTSim.Parent := tsSim ;
  fVTSim.Setup ;
  fVTSim.Images := ImageList ;

  ReadIniSettings ;

  fShChNot := TSHChangeNotify.Create( Self ) ;
  fShChNot.OnUpdateItem := DoUpdateItem ;
  // fShChNot.OnCreate := DoUpdateItem ;
  // fShChNot.Execute ;

  pgMain.ActivePage := tsSim ;

  if ParamCount > 0 then
    Elaborate( ParamStr( 1 ) ) ;
end ;

procedure TfrmMain.FormDestroy( Sender : TObject ) ;
begin
  fShChNot.Stop ;
  WriteIniSettings ;
  fState.Free ;
  fHelper.Free ;
end ;

procedure TfrmMain.ReadIniSettings ;
var
  IniFile : TIniFile ;
begin
  IniFile := TIniFile.Create( fIniname ) ;
  try
    with TPJVersionInfo.Create( Self ) do
      try
        Application.name := ProductName ;
        if HaveInfo and ( IniFile.ReadString( 'Main', 'LastVersion', '' ) <> FileVersion ) then
          actAbout.Execute ;
      finally
        Free ;
      end ;

    // MRU files
    // miMRU.LoadFromIni( IniFile, 'MRUList' ) ;
    fVTSim.Header.Columns[ 0 ].Width := IniFile.ReadInteger( 'Columns', '0', 200 ) ;
    fVTSim.Header.Columns[ 1 ].Width := IniFile.ReadInteger( 'Columns', '1', 200 ) ;
    fVTSim.Header.Columns[ 2 ].Width := IniFile.ReadInteger( 'Columns', '2', 100 ) ;

  finally
    IniFile.Free ;
  end ;
end ;

procedure TfrmMain.WriteIniSettings ;
var
  IniFile : TIniFile ;
begin
  IniFile := TIniFile.Create( fIniname ) ;
  try

    with TPJVersionInfo.Create( Self ) do
      try
        IniFile.WriteString( 'Main', 'LastVersion', FileVersion ) ;
      finally
        Free ;
      end ;

    // MRU files
    // miMRU.SaveToIni( IniFile, 'MRUList' ) ;
    IniFile.WriteInteger( 'Columns', '0', fVTSim.Header.Columns[ 0 ].Width ) ;
    IniFile.WriteInteger( 'Columns', '1', fVTSim.Header.Columns[ 1 ].Width ) ;
    IniFile.WriteInteger( 'Columns', '2', fVTSim.Header.Columns[ 2 ].Width ) ;

  finally
    IniFile.Free ;
  end ;
end ;

{ TFormHelper }

procedure TFormHelper.Execute ;
begin
  inherited ;
  while not Terminated do begin
    if gReader.FileExists( fFilename ) then begin
      if gReader.Open( fFilename ) then begin
        // Synchronize( ClearSimulation ) ;
        gReader.ReadSections ;
        gReader.Close ;
        if assigned( gReader.Hierarchy ) then
          Queue( PutSimulation ) ;
      end ;
    end ;
    Suspended := true ;
  end ;
end ;

procedure TFormHelper.SetFilename( const Value : string ) ;
begin
  fFilename := Value ;
  Suspended := False ;
end ;

procedure TFormHelper.ClearSimulation ;
begin
  with frmMain do begin
    fVTSim.HieRoot := nil ;
    Caption := Application.name ;
    lvNames.Clear ;
    lvTypes.Clear ;
    gReader.Clear ;
  end ;
end ;

procedure TFormHelper.PutSimulation ;
// var
// mi: TMenuItem;
begin
  with frmMain do begin
    fVTSim.HieRoot := gReader.Hierarchy ;
    Caption := Application.name + '  ' + fFilename ;
    // mi := TMenuItem.Create(frmMain);
    // miMRU.Items.Insert(0, mi);
    // mi.Caption := fFilename;
    // mi.OnClick := miMRUClick;
    ShowTypes ;
    ShowNames ;
  end ;
end ;

initialization

DecimalSeparator := '.' ;
SetMinimumBlockAlignment( mba16Byte ) ;
ReportMemoryLeaksOnShutdown := DebugHook <> 0 ;

System.AssertErrorProc := @AssertErrorHandler

end.
